home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / 74win / data1.cab / Lexical_Order_files / Labelchr.bas < prev    next >
Encoding:
BASIC Source File  |  2001-03-02  |  4.0 KB  |  172 lines
  1. 10 !RE-SAVE"LABELCHR.BAS"
  2. 20    INTEGER I
  3. 30    DIM Erase$[16]
  4. 40    COM /Setlabel/ INTEGER Erase
  5. 50    Erase=1
  6. 60    Erase$=" Erase  *ON/OFF "
  7. 70    !
  8. 80    CLEAR SCREEN
  9. 90    GINIT
  10. 100   GRAPHICS INPUT IS KBD,"KBD"
  11. 110   LORG 1
  12. 120   !
  13. 130   Set_grid(4)
  14. 140   Disp_chr(72)
  15. 150   Set_grid(3)
  16. 160   Disp_chr(103)
  17. 170   Draw_grid(2)
  18. 180   Show
  19. 190   Draw_grid(1)
  20. 200   OUTPUT KBD;"""LABELCHR Version 18-Dec-89"" E";
  21. 210   !
  22. 220   USER 1 KEYS
  23. 230   ON KEY 3 LABEL " Which    Grid?",1 CALL Grid
  24. 240   ON KEY 2 LABEL "Display   Char",1 CALL Disp
  25. 250   ON KEY 1 LABEL "Digitize  Char",1 CALL Digit
  26. 260   ON KEY 4 LABEL Erase$,1 GOSUB Toggle_erase
  27. 270   ON KEY 5 LABEL "  Show    Chars",1 CALL Show
  28. 280   FOR I=6 TO 7
  29. 290     ON KEY I LABEL "" GOSUB Dummy
  30. 300   NEXT I
  31. 310   ON KEY 8 LABEL "  EXIT" GOTO Exit
  32. 320 Idle: GOTO Idle
  33. 330   !
  34. 340   !
  35. 350 Dummy: RETURN
  36. 360   !
  37. 370   !
  38. 380 Toggle_erase:Erase= NOT Erase
  39. 390   Erase$[9;1]=CHR$(32+10*Erase)
  40. 400   Erase$[16;1]=CHR$(42-10*Erase)
  41. 410   ON KEY 4 LABEL Erase$,1 GOSUB Toggle_erase
  42. 420   RETURN
  43. 430   !
  44. 440   !
  45. 450 Exit: USER 2 KEYS
  46. 460   END
  47. 470   !
  48. 480   !
  49. 490   SUB Grid
  50. 500     INTEGER G
  51. 510     INPUT "Which grid do you wish to use?",G
  52. 520     IF G<1 OR G>4 THEN 510
  53. 530     Set_grid(G)
  54. 540   SUBEND
  55. 550   !
  56. 560   !
  57. 570   SUB Disp
  58. 580     INTEGER C
  59. 590     DIM L$[20]
  60. 600     !
  61. 610     INPUT "Which character do you wish to display?",L$
  62. 620     IF LEN(L$)=1 THEN
  63. 630       C=NUM(L$)
  64. 640     ELSE
  65. 650       C=VAL(L$)
  66. 660       IF C<0 OR C>255 THEN 610
  67. 670     END IF
  68. 680     Disp_chr(C)
  69. 690   SUBEND
  70. 700   !
  71. 710   !
  72. 720   SUB Draw_grid(INTEGER Grid)
  73. 730     Set_grid(Grid)
  74. 740     PEN 6
  75. 750     GRID 1,1
  76. 760   SUBEND
  77. 770   !
  78. 780   !
  79. 790   SUB Set_grid(INTEGER Grid)
  80. 800     INTEGER G
  81. 810     G=Grid-1 ! zero base
  82. 820     W1=RATIO*25
  83. 830     W=W1*.95
  84. 840     H=2*W
  85. 850     VIEWPORT G*W1,G*W1+W,99-H,99
  86. 860     WINDOW 0,7,0,15
  87. 870     DISP "Grid =";Grid
  88. 880   SUBEND
  89. 890   !
  90. 900   !
  91. 910   SUB Disp_chr(INTEGER C)
  92. 920     COM /Setlabel/ INTEGER Erase
  93. 930     IF Erase THEN
  94. 940       MOVE 0,0
  95. 950       AREA PEN 0
  96. 960       RECTANGLE 8,16,FILL
  97. 970       PEN 6
  98. 980       GRID 1,1
  99. 990     END IF
  100. 1000    PEN 1
  101. 1010    MOVE -1,1
  102. 1020    CSIZE 2*RATIO*25*.95,.643
  103. 1030    LABEL CHR$(C);
  104. 1040  SUBEND
  105. 1050  !
  106. 1060  !
  107. 1070  SUB Digit
  108. 1080    INTEGER B,I,C
  109. 1090    DIM A$[60]
  110. 1100    !
  111. 1110    DISP "Mouse: Left=Draw, Right=Move   KBD:arrows, then ENTER, then MOVE/DRAW softkey"
  112. 1120    FOR I=1 TO 8
  113. 1130      ON KEY I LABEL "" GOSUB Dummy
  114. 1140    NEXT I
  115. 1150    PEN 2
  116. 1160    TRACK CRT IS ON
  117. 1170    MOVE 0,0
  118. 1180    SET LOCATOR 0,0
  119. 1190    A$=""
  120. 1200    LOOP
  121. 1210      DIGITIZE X,Y,S$
  122. 1220    EXIT IF S$[3;1]<>"2"
  123. 1230      B=VAL(S$[7,8])
  124. 1240      X=PROUND(X,0)
  125. 1250      Y=PROUND(Y,0)
  126. 1260      SET LOCATOR X,Y ! set position for next DIGITIZE
  127. 1270      SET ECHO X,Y ! move crosshairs here, now
  128. 1280      !
  129. 1290      SELECT B
  130. 1300      CASE 0
  131. 1310        ON KEY 5 LABEL "  Draw",2 GOTO Draw
  132. 1320        ON KEY 6 LABEL "  Move",2 GOTO Move
  133. 1330        ON KEY 8 LABEL "Digitize  Done",2 GOTO Done
  134. 1340        GOTO 1340
  135. 1350 Draw:  DRAW X,Y
  136. 1360        C=SHIFT(X,-4)+Y
  137. 1370        GOTO 1400
  138. 1380 Move:  MOVE X,Y
  139. 1390        C=128+SHIFT(X,-4)+Y
  140. 1400        ON KEY 5 LABEL "" GOSUB Dummy
  141. 1410        ON KEY 6 LABEL "" GOSUB Dummy
  142. 1420        ON KEY 8 LABEL "" GOSUB Dummy
  143. 1430      CASE 1,3
  144. 1440        GOTO Draw
  145. 1450      CASE 2
  146. 1460        GOTO Move
  147. 1470      END SELECT
  148. 1480      DISP C;" ";
  149. 1490      A$=A$&CHR$(C)
  150. 1500    END LOOP
  151. 1510 Done: SET ECHO -100,-100
  152. 1520    INPUT "What char do you wish to assign this definition to? (-1=Don't assign)",C
  153. 1530    IF C>=0 AND C<256 THEN CONFIGURE LABEL C TO A$
  154. 1540    SUBEXIT
  155. 1550 Dummy: BEEP
  156. 1560    RETURN
  157. 1570  SUBEND
  158. 1580  !
  159. 1590  !
  160. 1600  SUB Show
  161. 1610    INTEGER I
  162. 1620    !
  163. 1630    PEN 1
  164. 1640    CSIZE 2*RATIO*25*.95/16,.643
  165. 1650    CLIP OFF
  166. 1660    FOR I=128 TO 255
  167. 1670      MOVE INT((I-128)/16),14-I MOD 16
  168. 1680      LABEL CHR$(I);
  169. 1690    NEXT I
  170. 1700    CLIP ON
  171. 1710  SUBEND
  172.